home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / dblrou1r / main.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1998-11-04  |  15.0 KB  |  441 lines
  1. VERSION 5.00
  2. Begin VB.Form Form1 
  3.    BackColor       =   &H00000000&
  4.    BorderStyle     =   0  'None
  5.    Caption         =   "Form1"
  6.    ClientHeight    =   7200
  7.    ClientLeft      =   0
  8.    ClientTop       =   0
  9.    ClientWidth     =   9600
  10.    FillStyle       =   0  'Solid
  11.    Icon            =   "main.frx":0000
  12.    LinkTopic       =   "Form1"
  13.    MaxButton       =   0   'False
  14.    MinButton       =   0   'False
  15.    ScaleHeight     =   480
  16.    ScaleMode       =   3  'Pixel
  17.    ScaleWidth      =   640
  18.    ShowInTaskbar   =   0   'False
  19.    StartUpPosition =   2  'CenterScreen
  20.    WindowState     =   2  'Maximized
  21.    Begin VB.Frame Frame1 
  22.       BackColor       =   &H00000000&
  23.       Caption         =   "-=Game=-"
  24.       BeginProperty Font 
  25.          Name            =   "Fixedsys"
  26.          Size            =   9
  27.          Charset         =   0
  28.          Weight          =   400
  29.          Underline       =   0   'False
  30.          Italic          =   0   'False
  31.          Strikethrough   =   0   'False
  32.       EndProperty
  33.       ForeColor       =   &H000000FF&
  34.       Height          =   7095
  35.       Left            =   7200
  36.       TabIndex        =   0
  37.       Top             =   0
  38.       Width           =   2295
  39.       Begin VB.CommandButton btnOutPut 
  40.          DisabledPicture =   "main.frx":0E42
  41.          DownPicture     =   "main.frx":21FC
  42.          BeginProperty Font 
  43.             Name            =   "Comic Sans MS"
  44.             Size            =   14.25
  45.             Charset         =   0
  46.             Weight          =   400
  47.             Underline       =   0   'False
  48.             Italic          =   0   'False
  49.             Strikethrough   =   0   'False
  50.          EndProperty
  51.          Height          =   495
  52.          Left            =   120
  53.          Picture         =   "main.frx":502E
  54.          Style           =   1  'Graphical
  55.          TabIndex        =   6
  56.          Top             =   2520
  57.          Width           =   2055
  58.       End
  59.       Begin VB.CommandButton btnPlay 
  60.          DisabledPicture =   "main.frx":7E60
  61.          DownPicture     =   "main.frx":921A
  62.          BeginProperty Font 
  63.             Name            =   "Fixedsys"
  64.             Size            =   9
  65.             Charset         =   0
  66.             Weight          =   400
  67.             Underline       =   0   'False
  68.             Italic          =   0   'False
  69.             Strikethrough   =   0   'False
  70.          EndProperty
  71.          Height          =   495
  72.          Left            =   120
  73.          Picture         =   "main.frx":C04C
  74.          Style           =   1  'Graphical
  75.          TabIndex        =   5
  76.          TabStop         =   0   'False
  77.          Top             =   1080
  78.          Width           =   2055
  79.       End
  80.       Begin VB.CommandButton btnQuit 
  81.          DisabledPicture =   "main.frx":EE7E
  82.          DownPicture     =   "main.frx":10238
  83.          BeginProperty Font 
  84.             Name            =   "Fixedsys"
  85.             Size            =   9
  86.             Charset         =   0
  87.             Weight          =   400
  88.             Underline       =   0   'False
  89.             Italic          =   0   'False
  90.             Strikethrough   =   0   'False
  91.          EndProperty
  92.          Height          =   495
  93.          Left            =   120
  94.          Picture         =   "main.frx":1306A
  95.          Style           =   1  'Graphical
  96.          TabIndex        =   4
  97.          TabStop         =   0   'False
  98.          Top             =   6360
  99.          Width           =   2055
  100.       End
  101.       Begin VB.CommandButton btnPauseResume 
  102.          DisabledPicture =   "main.frx":15E9C
  103.          DownPicture     =   "main.frx":17256
  104.          BeginProperty Font 
  105.             Name            =   "Fixedsys"
  106.             Size            =   9
  107.             Charset         =   0
  108.             Weight          =   400
  109.             Underline       =   0   'False
  110.             Italic          =   0   'False
  111.             Strikethrough   =   0   'False
  112.          EndProperty
  113.          Height          =   495
  114.          Left            =   120
  115.          Picture         =   "main.frx":1A088
  116.          Style           =   1  'Graphical
  117.          TabIndex        =   1
  118.          TabStop         =   0   'False
  119.          Top             =   1800
  120.          Width           =   2055
  121.       End
  122.       Begin VB.Label Label2 
  123.          BackStyle       =   0  'Transparent
  124.          Caption         =   "Player2:"
  125.          BeginProperty Font 
  126.             Name            =   "Fixedsys"
  127.             Size            =   9
  128.             Charset         =   0
  129.             Weight          =   400
  130.             Underline       =   0   'False
  131.             Italic          =   0   'False
  132.             Strikethrough   =   0   'False
  133.          EndProperty
  134.          ForeColor       =   &H00FF0000&
  135.          Height          =   255
  136.          Left            =   120
  137.          TabIndex        =   3
  138.          Top             =   600
  139.          Width           =   2055
  140.       End
  141.       Begin VB.Label Label1 
  142.          BackStyle       =   0  'Transparent
  143.          Caption         =   "Player1:"
  144.          BeginProperty Font 
  145.             Name            =   "Fixedsys"
  146.             Size            =   9
  147.             Charset         =   0
  148.             Weight          =   400
  149.             Underline       =   0   'False
  150.             Italic          =   0   'False
  151.             Strikethrough   =   0   'False
  152.          EndProperty
  153.          ForeColor       =   &H000000FF&
  154.          Height          =   255
  155.          Left            =   120
  156.          TabIndex        =   2
  157.          Top             =   360
  158.          Width           =   2055
  159.       End
  160.    End
  161. Attribute VB_Name = "Form1"
  162. Attribute VB_GlobalNameSpace = False
  163. Attribute VB_Creatable = False
  164. Attribute VB_PredeclaredId = True
  165. Attribute VB_Exposed = False
  166. ' Most of the game stuff if stuck in here... Feel free to browse the mess! It all works
  167. ' btw!!! :)
  168. ' This is the main game loop flag. To exit the program, just make bActive false
  169. Private bActive As Boolean
  170. ' This is the playing loop flag. To pause the game from playing, make this false
  171. Private bPaused As Boolean
  172. ' If the game screen should be refreshed (Redrawn), set this to false
  173. Private bRefreshed As Boolean
  174. ' This is player1
  175. Private Player1 As New Player
  176. ' This is player 2
  177. Private Player2 As New Player
  178. ' This is our customised, and infinitely kooler, messagebox
  179. Private MesBox As New MessBox
  180. ' Game input. Uses my own class wrapper for DirectInput which is part of the CDXVB
  181. ' library of class wrappers for DirectX in VB
  182. Private GameIN As New CDXVBInput
  183. Private GameMusic As New CDXVBMusic
  184. Private Sub btnOutPut_Click()
  185.       GameIN.UnAcquire
  186.       OutPutfrm.Show vbModal, Me
  187.       GameIN.ReAcquire
  188.       
  189.       ' Redraw the screen
  190.       bRefreshed = False
  191. End Sub
  192. Private Sub btnPauseResume_Click()
  193.       ' If the game is currently paused then load new bitmaps into pause/resume button
  194.       ' Otherwise, load other bitmaps
  195.       If bPaused Then
  196.             ' This little thang I thunk up is well handy... Checks to see if you are
  197.             ' in the root of the drive (\), if so, then load bitmaps without the '\'
  198.             ' in the pathname! (Prevents crashing when running from root like some
  199.             ' people may wish to)
  200.             If Mid(App.Path, 2, 1) = "\" Then
  201.                   btnPauseResume.Picture = LoadPicture(App.Path & "PAUSE.BMP")
  202.                   btnPauseResume.DisabledPicture = LoadPicture(App.Path & "PAUSEOFF.BMP")
  203.                   btnPauseResume.DownPicture = LoadPicture(App.Path & "PAUSEDOWN.BMP")
  204.             Else
  205.                   btnPauseResume.Picture = LoadPicture(App.Path & "\PAUSE.BMP")
  206.                   btnPauseResume.DisabledPicture = LoadPicture(App.Path & "\PAUSEOFF.BMP")
  207.                   btnPauseResume.DownPicture = LoadPicture(App.Path & "\PAUSEDOWN.BMP")
  208.             End If
  209.             bPaused = False
  210.       Else
  211.             If Mid(App.Path, 2, 1) = "\" Then
  212.                   btnPauseResume.Picture = LoadPicture(App.Path & "RESUME.BMP")
  213.                   btnPauseResume.DisabledPicture = LoadPicture(App.Path & "RESUMEOFF.BMP")
  214.                   btnPauseResume.DownPicture = LoadPicture(App.Path & "RESUMEDOWN.BMP")
  215.             Else
  216.                   btnPauseResume.Picture = LoadPicture(App.Path & "\RESUME.BMP")
  217.                   btnPauseResume.DisabledPicture = LoadPicture(App.Path & "\RESUMEOFF.BMP")
  218.                   btnPauseResume.DownPicture = LoadPicture(App.Path & "\RESUMEDOWN.BMP")
  219.             End If
  220.             bPaused = True
  221.       End If
  222. End Sub
  223. Private Sub btnPlay_Click()
  224.       ' Enable the pause/resume button
  225.       btnPauseResume.Enabled = True
  226.       
  227.       If Mid(App.Path, 2, 1) = "\" Then
  228.             GameMusic.Play App.Path & "InGame.mid"
  229.       Else
  230.             GameMusic.Play App.Path & "\InGame.mid"
  231.       End If
  232.       
  233.       GameIN.UnAcquire
  234.       Countfrm.Show vbModal, Me
  235.       GameIN.ReAcquire
  236.       
  237.       ' Unpause the game
  238.       bPaused = False
  239.       ' Disable the new-game button
  240.       btnPlay.Enabled = False
  241. End Sub
  242. Private Sub btnQuit_Click()
  243.       ' Shut down the main game loop
  244.       bActive = False
  245. End Sub
  246. Private Sub Form_Load()
  247.       ' Activate main game loop
  248.       bActive = True
  249.       ' Pause the game
  250.       bPaused = True
  251.       ' Our game screen doesn't require refreshing!
  252.       bRefreshed = True
  253.       ' Show the form (Wont get done becuz of loop unless we force it here
  254.       Me.Show
  255.       
  256.       ' Init the buffer
  257.       Call ScrBufInit
  258.       
  259.       ' Play MIDI music! (yay)
  260.       GameMusic.Init Me.hWnd
  261.       If Mid(App.Path, 2, 1) = "\" Then
  262.             GameMusic.Play App.Path & "Music.mid"
  263.       Else
  264.             GameMusic.Play App.Path & "\Music.mid"
  265.       End If
  266.       ' Player 1
  267.       Player1.Create Me.hDC, 0, 0, RGB(255, 0, 0), 1
  268.       Player1.ChangeDir DIR_RIGHT
  269.       Player1.ChangeDir DIR_STOPY
  270.       ' Player 2
  271.       Player2.Create Me.hDC, (GetSystemMetrics(SM_CXSCREEN) - 3) - Frame1.Width, GetSystemMetrics(SM_CYSCREEN) - 3, RGB(0, 0, 255), 2
  272.       Player2.ChangeDir DIR_LEFT
  273.       Player2.ChangeDir DIR_STOPY
  274.       
  275.       ' Disable pause/resume button until a new game is started!
  276.       btnPauseResume.Enabled = False
  277.       ' Init GUID's...
  278.       Call GUID_Initialize
  279.       ' Create input device
  280.       GameIN.Create App.hInstance, Me.hWnd
  281.       
  282.       ' Acquire the kb/mouse input devices
  283.       GameIN.ReAcquire
  284.       
  285.       ' Show the form (again) to force a decent repaint
  286.       Me.Show
  287.       ' Main game loop
  288.       While (bActive)
  289.             ' Process windows messages
  290.             DoEvents
  291.             
  292.             If bRefreshed = False Then
  293.                   ' Redraw stuff
  294.                   For X = 0 To UBound(ScrArr, 1)
  295.                         For Y = 0 To UBound(ScrArr, 2)
  296.                               If ScrArr(X, Y) = 1 Then
  297.                                     SetPixel Me.hDC, X, Y, RGB(255, 0, 0)
  298.                               ElseIf ScrArr(X, Y) = 2 Then
  299.                                     SetPixel Me.hDC, X, Y, RGB(0, 0, 255)
  300.                               End If
  301.                         Next Y
  302.                   Next X
  303.                   bRefreshed = True
  304.             End If
  305.             
  306.             If Not bPaused Then
  307.                   ' Update game input
  308.                   Call CheckInput
  309.             
  310.                   ' Move objects
  311.                   Call MoveObjs
  312.                   
  313.                   ' Test for collisions on objects
  314.                   Call CollisionObjs
  315.             
  316.                   ' Draw objects
  317.                   Call DrawObjs
  318.             End If
  319.       Wend
  320.       
  321.       ' Unacquire the input devices
  322.       GameIN.UnAcquire
  323.       
  324.       GameMusic.StopPlaying
  325.       
  326.       ' Unload the form
  327.       Unload Me
  328. End Sub
  329. Private Sub CheckInput()
  330.       ' Get latest keyboard input data
  331.       GameIN.UpdateKeyboard
  332.       
  333.       If Keys(DIK_W) Then
  334.             Player1.ChangeDir DIR_UP
  335.             Player1.ChangeDir DIR_STOPX
  336.       End If
  337.       If Keys(DIK_S) Then
  338.             Player1.ChangeDir DIR_DOWN
  339.             Player1.ChangeDir DIR_STOPX
  340.       End If
  341.       If Keys(DIK_A) Then
  342.             Player1.ChangeDir DIR_LEFT
  343.             Player1.ChangeDir DIR_STOPY
  344.       End If
  345.       If Keys(DIK_D) Then
  346.             Player1.ChangeDir DIR_RIGHT
  347.             Player1.ChangeDir DIR_STOPY
  348.       End If
  349.       
  350.       If Keys(DIK_UP) Then
  351.             Player2.ChangeDir DIR_UP
  352.             Player2.ChangeDir DIR_STOPX
  353.       End If
  354.       If Keys(DIK_DOWN) Then
  355.             Player2.ChangeDir DIR_DOWN
  356.             Player2.ChangeDir DIR_STOPX
  357.       End If
  358.       If Keys(DIK_LEFT) Then
  359.             Player2.ChangeDir DIR_LEFT
  360.             Player2.ChangeDir DIR_STOPY
  361.       End If
  362.       If Keys(DIK_RIGHT) Then
  363.             Player2.ChangeDir DIR_RIGHT
  364.             Player2.ChangeDir DIR_STOPY
  365.       End If
  366. End Sub
  367. Private Sub MoveObjs()
  368.       ' Move objects (2 players)
  369.       Player1.Move
  370.       Player2.Move
  371.       
  372.       ' Update player position labels (Used for slowing down the game!)
  373.       Label1.Caption = "Player1: " & Player1.m_PosX & ", " & Player1.m_PosY
  374.       Label2.Caption = "Player2: " & Player2.m_PosX & ", " & Player2.m_PosY
  375. End Sub
  376. Private Sub CollisionObjs()
  377.       ' If there is a collision between either of the players
  378.       If Player1.Collision(Player2) Then
  379.             GameIN.UnAcquire
  380.             MesBox.Change "Player2 won!"
  381.             MesBox.ShowIt Me
  382.             Call NewGame
  383.             Exit Sub
  384.       End If
  385.       If Player2.Collision(Player1) Then
  386.             GameIN.UnAcquire
  387.             MesBox.Change "Player1 won!"
  388.             MesBox.ShowIt Me
  389.             Call NewGame
  390.             Exit Sub
  391.       End If
  392. End Sub
  393. Private Sub DrawObjs()
  394.       ' Draw objects (2 players)
  395.       Player1.Draw
  396.       Player2.Draw
  397. End Sub
  398. Private Sub Form_Resize()
  399.       ' Resize the main-game frame
  400.       Frame1.Top = 0
  401.       Frame1.Left = Me.ScaleWidth - Frame1.Width
  402.       Frame1.Height = Me.ScaleHeight
  403.       
  404.       ' Move the quit button
  405.       btnQuit.Top = ((GetSystemMetrics(SM_CYSCREEN)) * 14) - (10 * 14)
  406. End Sub
  407. Private Sub NewGame()
  408.       ' Clear the screen (And thus, erase last game)
  409.       Cls
  410.       
  411.       ' Init(AND clear) screen array
  412.       Call ScrBufInit
  413.       
  414.       ' REACQUIRE the game input devices...
  415.       GameIN.ReAcquire
  416.       ' Pause the game
  417.       bPaused = True
  418.       ' Player 1
  419.       Player1.Create Me.hDC, 0, 0, RGB(255, 0, 0), 1
  420.       Player1.ChangeDir DIR_NEWGAME
  421.       Player1.ChangeDir DIR_RIGHT
  422.       Player1.ChangeDir DIR_STOPY
  423.       ' Player 2
  424.       Player2.Create Me.hDC, (GetSystemMetrics(SM_CXSCREEN) - 3) - Frame1.Width, GetSystemMetrics(SM_CYSCREEN) - 3, RGB(0, 0, 255), 2
  425.       Player2.ChangeDir DIR_NEWGAME
  426.       Player2.ChangeDir DIR_LEFT
  427.       Player2.ChangeDir DIR_STOPY
  428.       
  429.       ' Enable newgame button
  430.       btnPlay.Enabled = True
  431.       
  432.       If Mid(App.Path, 2, 1) = "\" Then
  433.             GameMusic.Play App.Path & "Music.mid"
  434.       Else
  435.             GameMusic.Play App.Path & "\Music.mid"
  436.       End If
  437.       
  438.       ' Disable pause/resume button until a new game is started!
  439.       btnPauseResume.Enabled = False
  440. End Sub
  441.